home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacWorld: Complete Mac Interactive
/
Macworld Complete Mac Interactive CD)(1994).iso
/
Software
/
More Shareware⁄Freeware
/
NIH Image 1.55 f (non fpu)
/
Macros
/
Demo Macro
< prev
next >
Wrap
Text File
|
1994-04-11
|
6KB
|
344 lines
procedure AdvanceRoi;
begin
hloc:=hloc+RoiWidth;
if (hloc+RoiWidth div 2)>PicWidth then begin
hloc:=0;
vloc:=vloc+RoiHeight;
end;
if (hloc+RoiWidth)>PicWidth then hloc:=PicWidth-RoiWidth;
if (vloc+RoiHeight)>PicHeight then vloc:=PicHeight-RoiHeight;
MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
end;
procedure MakeBlocks(n:integer);
var
i,hloc,vloc,PicWidth,PicHeight:integer;
RoiWidth,RoiHeight:integer;
scale:real;
begin
GetPicSize(PicWidth,PicHeight);
scale:=1/n;
SelectAll;
SetScaling('Nearest Neighbor; Same Window');
ScaleAndRotate(scale,scale,0);
RestoreRoi;
GetRoi(hloc,vloc,RoiWidth,RoiHeight);
copy;
SelectAll;
Clear;
hloc:=0;
vloc:=0;
MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
for i:=1 to n*n do begin
Paste;
AdvanceRoi;
end;
KillRoi;
end;
procedure DoTextDemo;
begin
RevertToSaved;
MoveTo(100,20);
SetForegroundColor(255);
SetBackgroundColor(0);
SetFont('Geneva');
SetFontSize(24);
SetText('No background, Bold, Center');
Writeln('Text');
SetText('With background');
Writeln('With Background');
SetText('Bold');
Writeln('Bold');
SetText('Underlined');
Writeln('Underlined');
SetText('Italic');
Writeln('Italics');
SetText('Outline');
Writeln('Outlined');
SetText('Shadow');
Writeln('Shadowed');
SetText('Plain');
SetFontSize(9);
MoveTo(100,240);
Writeln('Very small');
wait(.5);
SetFontSize(24);
MoveTo(100,240);
Writeln('Small');
wait(.5);
SetFontSize(48);
MoveTo(100,240);
SetText('Bold');
Writeln('MEDIAN');
wait(.5);
SetFontSize(96);
MoveTo(100,240);
Writeln('LARGE');
wait(1);
end;
procedure DrawGrayLevelScale(nBoxes:integer);
var
PicWidth, PicHeight,i,GrayLevel,hloc,vloc,width,height,vdelta:integer;
begin
GetPicSize(PicWidth,PicHeight);
SetFont('Helvetica');
SetFontSize(9);
SetText('Bold; Center; with background');
SetBackgroundColor(0);
width:=0.9*PicHeight/nBoxes;
height:=width;
hloc:=0.05*PicHeight;
vloc:=hloc;
vdelta:=height-1;
GrayLevel:=0;
for i:=1 to nBoxes do begin
MakeRoi(hloc,vloc,width,height);
SetForeground(GrayLevel);
Fill;
SetForeground(255);
DrawBoundary;
MoveTo(hloc+width/2,vloc+height/2);
Writeln(GrayLevel);
GrayLevel:=GrayLevel+trunc(256/nBoxes);
vloc:=vloc+vdelta;
end;
end;
procedure DrawColorScale;
var
top,left,width,height,nLabels,i,tvloc:integer;
begin
nLabels:=16;
SetFontSize(12);
SetFont('Helvetica');
SetText('Right Justified');
DrawScale;
GetRoi(left,top,width,height);
KillRoi;
SetForeground(255); {black}
SetBackground(0); {255}
vloc:=top;
for i:=1 to nLabels do begin
MoveTo(left+width+25,vloc+3);
tvloc:=vloc;
if tvloc>(top+height-1) then tvloc:=Top+height-1;
Writeln(GetPixel(left,tvloc));
vloc:=vloc+round(height/(nLabels-1));
end;
end;
procedure DoColorScaleDemo;
var
PicWidth,PicHeight,hloc,vloc,ScaleWidth,ScaleHeight:integer;
begin
GetPicSize(PicWidth,PicHeight);
width:=0.1*PicWidth;
if width>40 then width:=40;
height:=0.9*PicHeight;
hloc:=0.05*PicHeight;
vloc:=hloc;
SetPalette('Spectrum');
MakeRoi(hloc,vloc,width,height);
DrawColorScale;
wait(2);
SetPalette('Grayscale');
end;
procedure DemoFilters;
var
hloc,vloc,RoiWidth,RoiHeight,PicWidth,PicHeight:integer;
begin
MakeBlocks(3);
RestoreRoi;
GetRoi(hloc,vloc,RoiWidth,RoiHeight);
GetPicSize(PicWidth,PicHeight);
hloc:=0; vloc:=0;
AdvanceRoi;
SetOption; Sharpen;
AdvanceRoi;
Shadow;
AdvanceRoi;
TraceEdges;
AdvanceRoi;
SetOption; Smooth;
TraceEdges;
Skeletonize;
AdvanceRoi;
Dither;
AdvanceRoi;
Invert;
AdvanceRoi;
FlipVertical;
AdvanceRoi;
FlipHorizontal;
end;
procedure MakeGrayLevelGrid;
var
i,hloc,vloc,PicWidth,PicHeight:integer;
RoiWidth,RoiHeight,GrayLevel,increment:integer;
scale:real;
begin
n:=5;
GetPicSize(PicWidth,PicHeight);
hloc:=0;
vloc:=0;
RoiWidth:=PicWidth div n;
RoiHeight:=PicHeight div n;
MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
GrayLevel:=255;
increment:=round(256/(n*n));
SetLineWidth(1);
for i:=1 to n*n do begin
SetForeground(GrayLevel);
fill;
SetForeground(0);
DrawBoundary;
GrayLevel:=GrayLevel-increment;
if GrayLevel<0 then GrayLevel:=0;
AdvanceRoi;
end;
KillRoi;
end;
macro 'Demo Macro [D]'
{
This macro demonstrate many of the features available in Image's macro
language. It assumes the Image at least as large as`256x256 has been opened.
}
var
i:integer;
width,height,n,W,H:integer;
scale:real;
NoImage:boolean;
StartTicks,time:real;
begin
StartTicks:=TickCount;
NoImage:=nPics<>1;
if not NoImage then GetPicSize(width,height);
if NoImage or (width<256) or (height<256) then begin
PutMessage('This macro needs a single image at least 256 pixels wide and 256 pixels high to operate on.');
Exit;
end;
SaveState;
DemoFilters;
wait(2);
RevertToSaved;
MakeGrayLevelGrid;
wait(1);
RevertToSaved;
DrawGrayLevelScale(12);
wait(1);
RevertToSaved;
DoColorScaleDemo;
DoTextDemo;
RevertToSaved;
SetScaling('Nearest Neighbor; Same Window');
for i:= 1 to 4 do begin
ScaleAndRotate(1.5,1.5,0);
wait(.5);
end;
RevertToSaved;
for i:=1 to 6 do begin
ScaleAndRotate(0.6,0.6,0);
wait(.5);
RestoreRoi;
end;
RevertToSaved;
wait(.5);
ScaleAndRotate(.333,1,0);
wait(1);
Undo;
ScaleAndRotate(1,.333,0);
wait(1);
Undo;
FlipVertical;
wait(.5);
Undo;
FlipHorizontal;
wait(.5);
Undo;
RotateRight(true);
RotateLeft(true);
Shadow;
Wait(1);
Undo;
Duplicate('Temp');
Smooth;
for i:=1 to 3 do begin SetOption; Sharpen end;
wait(.5);
Dispose;
SelectPic(1);
Dither;
wait(.5);
Undo;
AddConstant(100);
Wait(1);
Undo;
AddConstant(-100);
Wait(1);
EnhanceContrast;
Wait(.5);
Undo;
EqualizeHistogram;
Wait(.5);
ResetGraymap;
ShowHistogram;
Smooth;
TraceEdges;
wait(.5);
Erode;
Dilate;
Outline;
Undo;
Skeletonize;
Wait(1);
for i:= 1 to 12 do TraceEdges;
RestoreState;
time:=(TickCount-StartTicks)/60;
ShowMessage('time=',time:1:2,' seconds');
end;
macro 'Make Wallpaper… [M]'
var
width,height,n:integer;
begin
GetPicSize(width,height);
if (width=0) then begin
PutMessage('This macro needs an image to operate on.');
Exit;
end;
n:=trunc(GetNumber('Replication factor:',8));
SaveState;
MakeBlocks(n);
RestoreState;
end;